-- -- Copyright 2014 Alessandro Gerlinger Romero -- -- This file is part of Hybrid fUML. -- -- Hybrid fUML is free software: you can redistribute it and/or modify -- it under the terms of the GNU General Public License as published by -- the Free Software Foundation, either version 3 of the License, or -- (at your option) any later version. -- -- Hybrid fUML is distributed in the hope that it will be useful, -- but WITHOUT ANY WARRANTY; without even the implied warranty of -- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -- GNU General Public License for more details. -- -- You should have received a copy of the GNU General Public License -- along with Hybrid fUML. If not, see . -- ------------------------------------------------------------------------------------------------------------------------------------------------------------ ------------------------------------------------------------------------------------------------------------------------------------------------------------ -- ACTIONS ------------------------------------------------------------------------------------------------------------------------------------------------------------ ------------------------------------------------------------------------------------------------------------------------------------------------------------ -- APPROACH -- SEMANTICVISITOR NOT RELATED WITH VALUE ARE IMPLEMENTED AS RULES -- THERE ARE NO DATA FOR ...Activation -- RULES DEFINITION ------------------------------------------------------------------------------------------------------------------------------------------------------------ -- CLASS FUML_Semantics_Actions_IntermediateActions_ValueSpecificationActionActivation -- FUML_Syntax_Actions_IntermediateActions_ValueSpecificationAction -- operatio_ValueSpecificationActionActivation_doAction :: FUML_Semantics_Activities_IntermediateActivities_ActivityNodeActivation -> Rule () operatio_ValueSpecificationActionActivation_doAction (vl, vsa) = let vsab = (function_ActivityNode_type(vsa) == FUML_Syntax_Actions_IntermediateActions_ValueSpecificationAction) in let acvsab = function_fUML_activityHasNode (function_fUML_activity vl) vsa in let v = function_ActivityNode_ValueSpecificationAction_value vsa in let r = function_ActivityNode_ValueSpecificationAction_result vsa in -- checking -- it is a ValueSpecificationAction, is for the classifier from the value, has a value and has a result if vsab && acvsab && v /= FUML_Syntax_Classes_Kernel_ValueSpecificationEmpty && r /= FUML_Syntax_Activities_IntermediateActivities_ActivityNodeEmpty then let ex = function_Locus_executor (function_Value_ExtensionalValue_locus vl) in -- checking -- it has token if function_ActivityNodeActivation_isReady(vl, vsa) then do -- evaluate vc <- (operatio_Executor_evaluate ex v) -- create object token ot <- (rule_FUML_Semantics_Activities_IntermediateActivities_Token_create FUML_Semantics_Activities_IntermediateActivities_ObjectToken) function_Token_ObjectToken_value(ot):= vc function_ActivityNodeActivation_heldTokens(vl,r) := {ot} else -- stdout rule_fUML_out $ "operatio_ValueSpecificationActionActivation_doAction - partially evaluated " ++ show (function_fUML_activity vl) ++ show vsa else if vsab && acvsab then -- stdout rule_fUML_out $ "operatio_ValueSpecificationActionActivation_doAction - partially evaluated " ++ show (function_fUML_activity vl) ++ show vsa else skip ------------------------------------------------------------------------------------------------------------------------------------------------------------ -- CLASS FUML_Semantics_Actions_IntermediateActions_CreateObjectActionActivation -- FUML_Syntax_Actions_IntermediateActions_CreateObjectAction -- operatio_CreateObjectActionActivation_doAction :: FUML_Semantics_Activities_IntermediateActivities_ActivityNodeActivation -> Rule () operatio_CreateObjectActionActivation_doAction (vl, coa) = let coab = (function_ActivityNode_type(coa) == FUML_Syntax_Actions_IntermediateActions_CreateObjectAction) in let accoab = function_fUML_activityHasNode (function_fUML_activity vl) coa in let cl = function_ActivityNode_CreateObjectAction_classifier coa in let r = function_ActivityNode_CreateObjectAction_result coa in -- checking -- it is a CreateObjectAction, is for the classifier from the value, has a value and has a result if coab && accoab && cl /= FUML_Syntax_Classes_Kernel_ClassifierEmpty && r /= FUML_Syntax_Activities_IntermediateActivities_ActivityNodeEmpty then -- checking -- it has token if function_ActivityNodeActivation_isReady(vl, coa) then do -- create object o <- (operatio_Locus_instantiate (function_Value_ExtensionalValue_locus vl) cl) ref <- (rule_FUML_Semantics_Classes_Kernel_Value_create FUML_Semantics_Classes_Kernel_Reference) -- create object token with a reference to original object ot <- (rule_FUML_Semantics_Activities_IntermediateActivities_Token_create FUML_Semantics_Activities_IntermediateActivities_ObjectToken) function_Value_Reference_referent(ref):= o function_Token_ObjectToken_value(ot):= ref function_ActivityNodeActivation_heldTokens(vl,r) := {ot} else -- stdout rule_fUML_out $ "operatio_CreateObjectActionActivation_doAction - partially evaluated " ++ show (function_fUML_activity vl) ++ show coa else if coab && accoab then -- stdout rule_fUML_out $ "operatio_CreateObjectActionActivation_doAction - partially evaluated " ++ show (function_fUML_activity vl) ++ show coa else skip ------------------------------------------------------------------------------------------------------------------------------------------------------------ -- CLASS FUML_Semantics_Actions_IntermediateActions_AddStructuralFeatureValueActionActivation -- FUML_Syntax_Actions_IntermediateActions_AddStructuralFeatureValueAction -- -- TODO LOW PRIORITY ONLY SINGLE VALUED PROPERTIES operatio_AddStructuralFeatureValueActionActivation_doAction :: FUML_Semantics_Activities_IntermediateActivities_ActivityNodeActivation -> Rule () operatio_AddStructuralFeatureValueActionActivation_doAction (vl, aa) = let aab = (function_ActivityNode_type(aa) == FUML_Syntax_Actions_IntermediateActions_AddStructuralFeatureValueAction) in let acaab = function_fUML_activityHasNode (function_fUML_activity vl) aa in let on = function_ActivityNode_StructuralFeatureAction_object aa in let vn = function_ActivityNode_WriteStructuralFeatureAction_value aa in let res = function_ActivityNode_WriteStructuralFeatureAction_result aa in let f = function_ActivityNode_StructuralFeatureAction_structuralFeature aa in -- checking -- it is a FUML_Syntax_Actions_IntermediateActions_AddStructuralFeatureValueAction, is for the classifier from the value, has an object, has a value, has a result, and has a feature if aab && acaab && on /= FUML_Syntax_Activities_IntermediateActivities_ActivityNodeEmpty && vn /= FUML_Syntax_Activities_IntermediateActivities_ActivityNodeEmpty && res /= FUML_Syntax_Activities_IntermediateActivities_ActivityNodeEmpty && f /= FUML_Syntax_Classes_Kernel_FeatureEmpty then -- tokens let oto = one $ function_ActivityNodeActivation_heldTokens (vl,on) in let otv = one $ function_ActivityNodeActivation_heldTokens (vl,vn) in -- values let val = function_Token_ObjectToken_value oto in let fvl = function_Token_ObjectToken_value otv in -- checking -- it has token in the inputpin, the token has value, -- it has a control token, -- and it has value token and value for the VALUE if oto /= FUML_Semantics_Activities_IntermediateActivities_TokenEmpty && val /= FUML_Semantics_Classes_Kernel_ValueEmpty && function_ActivityNodeActivation_isReady(vl, aa) && otv /= FUML_Semantics_Activities_IntermediateActivities_TokenEmpty && fvl /= FUML_Semantics_Classes_Kernel_ValueEmpty then if function_ActivityNode_AddStructuralFeatureValueAction_insertAt aa /= FUML_Syntax_Activities_IntermediateActivities_ActivityNodeEmpty then error("operatio_AddStructuralFeatureValueActionActivation_doAction - insertAt is not supported. " ++ show aa) else do -- remove token from the input used function_ActivityNodeActivation_heldTokens(vl,on) := function_ActivityNodeActivation_heldTokens(vl,on) `difference` {oto} function_Token_ObjectToken_value(oto):= FUML_Semantics_Classes_Kernel_ValueEmpty -- create token ot <- (rule_FUML_Semantics_Activities_IntermediateActivities_Token_create FUML_Semantics_Activities_IntermediateActivities_ObjectToken) function_ActivityNodeActivation_heldTokens(vl,res) := {ot} if function_Value_type(val) /= FUML_Semantics_Classes_Kernel_Reference then do -- copy object for data types objnew <- (operatio_Value_copy val) function_Token_ObjectToken_value(ot):= objnew else function_Token_ObjectToken_value(ot):= val -- seq allows to access the new copy `seq` -- add the feature let otor = one $ function_ActivityNodeActivation_heldTokens(vl,res) in let valr = function_Token_ObjectToken_value otor in -- select the object let obj = if function_Value_type(valr) /= FUML_Semantics_Classes_Kernel_Reference then valr else function_Value_Reference_referent valr in do -- remove token from the input used function_ActivityNodeActivation_heldTokens(vl,vn) := function_ActivityNodeActivation_heldTokens(vl,vn) `difference` {otv} function_Token_ObjectToken_value(otv):= FUML_Semantics_Classes_Kernel_ValueEmpty -- adding feature rule_fUML_addStructuralFeature obj f fvl else -- stdout rule_fUML_out $ "operatio_AddStructuralFeatureValueActionActivation_doAction - partially evaluated " ++ show (function_fUML_activity vl) ++ show aa ++ show val ++ show oto else if aab && acaab then -- stdout rule_fUML_out $ "operatio_AddStructuralFeatureValueActionActivation_doAction - partially evaluated " ++ show (function_fUML_activity vl) ++ show aa else skip ------------------------------------------------------------------------------------------------------------------------------------------------------------ -- CLASS FUML_Semantics_Actions_IntermediateActions_ClearStructuralFeatureActionActivation -- FUML_Syntax_Actions_IntermediateActions_ClearStructuralFeatureAction -- operatio_ClearStructuralFeatureActionActivation_doAction :: FUML_Semantics_Activities_IntermediateActivities_ActivityNodeActivation -> Rule () operatio_ClearStructuralFeatureActionActivation_doAction (vl, ca) = let cab = (function_ActivityNode_type(ca) == FUML_Syntax_Actions_IntermediateActions_ClearStructuralFeatureAction) in let accab = function_fUML_activityHasNode (function_fUML_activity vl) ca in let on = function_ActivityNode_StructuralFeatureAction_object ca in let res = function_ActivityNode_ClearStructuralFeatureAction_result ca in let f = function_ActivityNode_StructuralFeatureAction_structuralFeature ca in -- checking -- it is a CleartructuralFeatureAction, is for the classifier from the value, has an object, has a result, and has a feature if cab && accab && on /= FUML_Syntax_Activities_IntermediateActivities_ActivityNodeEmpty && res /= FUML_Syntax_Activities_IntermediateActivities_ActivityNodeEmpty && f /= FUML_Syntax_Classes_Kernel_FeatureEmpty then -- tokens let oto = one $ function_ActivityNodeActivation_heldTokens (vl,on) in -- values let val = function_Token_ObjectToken_value oto in -- checking -- it has token in the inputpin, the token has value, and it has a control token if oto /= FUML_Semantics_Activities_IntermediateActivities_TokenEmpty && val /= FUML_Semantics_Classes_Kernel_ValueEmpty && function_ActivityNodeActivation_isReady(vl, ca) then do -- remove token from inputs function_ActivityNodeActivation_heldTokens(vl,on) := function_ActivityNodeActivation_heldTokens(vl,on) `difference` {oto} function_Token_ObjectToken_value(oto):= FUML_Semantics_Classes_Kernel_ValueEmpty -- create token ot <- (rule_FUML_Semantics_Activities_IntermediateActivities_Token_create FUML_Semantics_Activities_IntermediateActivities_ObjectToken) function_ActivityNodeActivation_heldTokens(vl,res) := {ot} if function_Value_type(val) /= FUML_Semantics_Classes_Kernel_Reference then do -- copy object for data types objnew <- (operatio_Value_copy val) function_Token_ObjectToken_value(ot):= objnew else function_Token_ObjectToken_value(ot):= val -- seq allows to access the new copy `seq` -- clear the feature let otor = one $ function_ActivityNodeActivation_heldTokens(vl,res) in let valr = function_Token_ObjectToken_value otor in -- select the object let obj = if function_Value_type(valr) /= FUML_Semantics_Classes_Kernel_Reference then valr else function_Value_Reference_referent valr in let fvl = filter (\fv -> (function_FeatureValue_feature fv) == f) (expr2list $ function_Value_CompoundValue_featureValues obj) in do forall fv <- fvl do -- clear the value... not the featurevalue function_FeatureValue_values(fv) := [] else -- stdout rule_fUML_out $ "operatio_ClearStructuralFeatureActionActivation_doAction - partially evaluated " ++ show (function_fUML_activity vl) ++ show ca ++ show val ++ show oto else if cab && accab then -- stdout rule_fUML_out $ "operatio_ClearStructuralFeatureActionActivation_doAction - partially evaluated " ++ show (function_fUML_activity vl) ++ show ca else skip ------------------------------------------------------------------------------------------------------------------------------------------------------------ -- CLASS FUML_Semantics_Actions_IntermediateActions_ReadStructuralFeatureActionActivation -- FUML_Syntax_Actions_IntermediateActions_ReadStructuralFeatureAction -- -- TODO LOW PRIORITY ONLY SINGLE VALUED PROPERTIES operatio_ReadStructuralFeatureActionActivation_doAction :: FUML_Semantics_Activities_IntermediateActivities_ActivityNodeActivation -> Rule () operatio_ReadStructuralFeatureActionActivation_doAction (vl, ra) = let rab = (function_ActivityNode_type(ra) == FUML_Syntax_Actions_IntermediateActions_ReadStructuralFeatureAction) in let acrab = function_fUML_activityHasNode (function_fUML_activity vl) ra in let on = function_ActivityNode_StructuralFeatureAction_object ra in let res = function_ActivityNode_ReadStructuralFeatureAction_result ra in let f = function_ActivityNode_StructuralFeatureAction_structuralFeature ra in -- checking -- it is a ReadStructuralFeatureAction, is for the classifier from the value, has an object, has a result, and has a feature if rab && acrab && on /= FUML_Syntax_Activities_IntermediateActivities_ActivityNodeEmpty && res /= FUML_Syntax_Activities_IntermediateActivities_ActivityNodeEmpty && f /= FUML_Syntax_Classes_Kernel_FeatureEmpty then -- tokens let oto = one $ function_ActivityNodeActivation_heldTokens (vl,on) in -- values let val = function_Token_ObjectToken_value oto in -- load featurefeaturevalue let obj = function_Value_Reference_referent val in let vlo = function_fUML_readStructuralFeature obj f in let vld = function_fUML_readStructuralFeature val f in -- checking -- it has token in the inputpin, the token has value, -- it has a control token, -- and it has value for the feature if oto /= FUML_Semantics_Activities_IntermediateActivities_TokenEmpty && val /= FUML_Semantics_Classes_Kernel_ValueEmpty && function_ActivityNodeActivation_isReady(vl, ra) then -- enabling retrieve of null value --((function_Value_type(val) == FUML_Semantics_Classes_Kernel_Reference && vlo /= FUML_Semantics_Classes_Kernel_ValueEmpty) || -- (function_Value_type(val) /= FUML_Semantics_Classes_Kernel_Reference && vld /= FUML_Semantics_Classes_Kernel_ValueEmpty) ) then -- waits until the edge if it is a read for edge and timeedge is defined if (function_fUML_stereotypedActivityNode Edge ra) && not (function_Locus_physicalClkIsOnEdge (function_Value_ExtensionalValue_locus vl)) then -- marking that no other node is running rule_fUML_activityExecution_suspend vl FUML_Status_WaitingEdgeValue ra else let rv = if function_Value_type(val) == FUML_Semantics_Classes_Kernel_Reference then vlo else vld in do -- remove token from inputs function_ActivityNodeActivation_heldTokens(vl,on) := function_ActivityNodeActivation_heldTokens(vl,on) `difference` {oto} function_Token_ObjectToken_value(oto):= FUML_Semantics_Classes_Kernel_ValueEmpty -- set object token ot <- (rule_FUML_Semantics_Activities_IntermediateActivities_Token_create FUML_Semantics_Activities_IntermediateActivities_ObjectToken) function_ActivityNodeActivation_heldTokens(vl,res) := {ot} function_Token_ObjectToken_value(ot):= rv else -- stdout rule_fUML_out $ "operatio_ReadStructuralFeatureActionActivation_doAction - partially evaluated " ++ show (function_fUML_activity vl) ++ show ra ++ show val ++ show oto else if rab && acrab then -- stdout rule_fUML_out $ "operatio_ReadStructuralFeatureActionActivation_doAction - partially evaluated " ++ show (function_fUML_activity vl) ++ show ra else skip ------------------------------------------------------------------------------------------------------------------------------------------------------------ -- CLASS FUML_Semantics_Actions_IntermediateActions_ReadSelfActionActivation -- FUML_Syntax_Actions_IntermediateActions_ReadSelfAction -- operatio_ReadSelfActionActivation_doAction :: FUML_Semantics_Activities_IntermediateActivities_ActivityNodeActivation -> Rule () operatio_ReadSelfActionActivation_doAction (vl, rsa) = let rsab = (function_ActivityNode_type(rsa) == FUML_Syntax_Actions_IntermediateActions_ReadSelfAction) in let acrsab = function_fUML_activityHasNode (function_fUML_activity vl) rsa in let res = function_ActivityNode_ReadSelfAction_result rsa in -- checking -- it is a ReadSelfAction, is for the classifier from the value, and has a result if rsab && acrsab && res /= FUML_Syntax_Activities_IntermediateActivities_ActivityNodeEmpty then -- checking -- it has token if function_ActivityNodeActivation_isReady(vl, rsa) then do -- create object token with a reference to the context of the value -- can generate a token with VALUEEMPTY ot <- (rule_FUML_Semantics_Activities_IntermediateActivities_Token_create FUML_Semantics_Activities_IntermediateActivities_ObjectToken) ref <- (rule_FUML_Semantics_Classes_Kernel_Value_create FUML_Semantics_Classes_Kernel_Reference) function_Value_Reference_referent(ref):= (function_Value_Execution_context vl) function_Token_ObjectToken_value(ot):= ref function_ActivityNodeActivation_heldTokens(vl,res) := {ot} else -- stdout rule_fUML_out $ "operatio_ReadSelfActionActivation_doAction - partially evaluated " ++ show (function_fUML_activity vl) ++ show rsa else if rsab && acrsab then -- stdout rule_fUML_out $ "operatio_ReadSelfActionActivation_doAction - partially evaluated " ++ show (function_fUML_activity vl) ++ show rsa else skip ------------------------------------------------------------------------------------------------------------------------------------------------------------ -- CLASS FUML_Semantics_Actions_BasicActions_SendSignalActionActivation -- FUML_Syntax_Actions_BasicActions_SendSignalAction -- operatio_SendSignalActionActivation_doAction :: FUML_Semantics_Activities_IntermediateActivities_ActivityNodeActivation -> Rule () operatio_SendSignalActionActivation_doAction (vl, ssa) = let ssab = (function_ActivityNode_type(ssa) == FUML_Syntax_Actions_BasicActions_SendSignalAction) in let acssab = function_fUML_activityHasNode (function_fUML_activity vl) ssa in let sig = function_ActivityNode_SendSignalAction_signal ssa in let tg = function_ActivityNode_SendSignalAction_target ssa in -- checking -- it is a SendSignalAction, is for the classifier from the value, has a target and has a signal if ssab && acssab && tg /= FUML_Syntax_Activities_IntermediateActivities_ActivityNodeEmpty && sig /= FUML_Syntax_Classes_Kernel_ClassifierEmpty then -- tokens let oto = one $ function_ActivityNodeActivation_heldTokens (vl,tg) in -- values let val = function_Token_ObjectToken_value oto in let obj = function_Value_Reference_referent val in -- checking -- it has token in the inputpin, the token has value, -- and it has a control token if oto /= FUML_Semantics_Activities_IntermediateActivities_TokenEmpty && val /= FUML_Semantics_Classes_Kernel_ValueEmpty && function_ActivityNodeActivation_isReady(vl, ssa) then -- -- USES seq to allow evaluation and comparison of the recently created signal do -- new signal o <- (rule_FUML_Semantics_Classes_Kernel_Value_create FUML_Semantics_CommonBehaviors_Communications_SignalInstance) -- type of new signal function_Value_SignalInstance_type(o) := sig -- setting the values for each attribute with the input pins -- removing tokens if length inpl > 0 then -- VERY IMPORTANT -- IT MUST USE EVALUATION OF RULES IN SEQUENCE due to the fact of concurrent change in a function with domain object foldl1 (seq) $ (map (\(inp,inpt) -> do -- adding value to an attribute (must be the name of the input pin) -- it shall pass classifier because the rules are running in parallel rule_fUML_addStructuralFeatureStringWithClassifier sig o (function_ActivityNode_NamedElement_name inp) (function_Token_ObjectToken_value inpt) -- removing used token function_ActivityNodeActivation_heldTokens(vl,inp) := function_ActivityNodeActivation_heldTokens(vl,inp) `difference` {inpt} function_Token_ObjectToken_value(inpt):= FUML_Semantics_Classes_Kernel_ValueEmpty ) inplt) else skip -- storing signal function_fUML_storeSignalSupport(vl, ssa) := o `seq` do -- sending signal rule_fUML_addSignalValue ((function_ActivityNode_NamedElement_name ssa), (function_Value_Execution_context vl), obj, sig, (function_fUML_storeSignalSupport(vl, ssa))) function_fUML_storeSignalSupport(vl, ssa) := FUML_Semantics_Classes_Kernel_ValueEmpty -- removing target token function_ActivityNodeActivation_heldTokens(vl,tg) := function_ActivityNodeActivation_heldTokens(vl,tg) `difference` {oto} function_Token_ObjectToken_value(oto):= FUML_Semantics_Classes_Kernel_ValueEmpty -- stdout --rule_fUML_out $ "operatio_SendSignalActionActivation_doAction - sent " ++ show sig else -- stdout rule_fUML_out $ "operatio_SendSignalActionActivation_doAction - partially evaluated " ++ show (function_fUML_activity vl) ++ show ssa else if ssab && acssab then -- stdout rule_fUML_out $ "operatio_SendSignalActionActivation_doAction - partially evaluated " ++ show (function_fUML_activity vl) ++ show ssa else skip where -- attributes from node inpl = filter (\n -> (function_ActivityNode_NamedElement_name n) /= "target") $ expr2list $ function_ActivityNode_Action_input ssa inplt = map (\inp -> (inp,one $ function_ActivityNodeActivation_heldTokens(vl,inp))) inpl -- -- function to support evaluation and comparison in differents steps function_fUML_storeSignalSupport :: Dynamic( FUML_Semantics_Activities_IntermediateActivities_ActivityNodeActivation -> FUML_Semantics_Classes_Kernel_Value ) function_fUML_storeSignalSupport = initAssocs' "storeSignalSupport" FUML_Semantics_Classes_Kernel_ValueEmpty asmLt (==) [] ------------------------------------------------------------------------------------------------------------------------------------------------------------ -- CLASS FUML_Semantics_Actions_BasicActions_SendSignalActionActivation -- FUML_Syntax_Actions_BasicActions_SendSignalAction -- -- it does not allow more than one trigger (it can cause nondeterminism) -- -- if it has more than one signal, all signals are made available -- TODO LOW PRIORITY - this will cause errors in case of multiple signals - semantics shall be enhanced to cover this case operatio_AcceptEventActionActivation_doAction :: FUML_Semantics_Activities_IntermediateActivities_ActivityNodeActivation -> Rule () operatio_AcceptEventActionActivation_doAction (vl, aea) = let aeab = (function_ActivityNode_type(aea) == FUML_Syntax_Actions_CompleteActions_AcceptEventAction) in let acaeab = function_fUML_activityHasNode (function_fUML_activity vl) aea in let res = one $ function_ActivityNode_AcceptEventAction_result aea in let tr = one $ function_ActivityNode_AcceptEventAction_trigger aea in -- checking -- it is a AcceptEventAction, is for the classifier from the value, has a result and has triggers if aeab && acaeab && res /= FUML_Syntax_Activities_IntermediateActivities_ActivityNodeEmpty && tr /= FUML_Syntax_CommonBehaviors_Communications_TriggerEmpty then -- checking -- if it has a control token and -- its classifierbehavior is running if function_ActivityNodeActivation_isReady(vl, aea) && function_fUML_classifierBehaviorIsRunning ct then let l = (function_Value_ExtensionalValue_locus vl) in let vsInitP1 = function_ActivityNode_ValueSpecificationForAppliedStereotype aea Previous InitialValue in let vsInitP2 = function_ActivityNode_ValueSpecificationForAppliedStereotype aea PrecededBy InitialValue in let ex = function_Locus_executor l in do -- checking trigger if card (function_ActivityNode_AcceptEventAction_trigger aea) > 1 then error( "operatio_AcceptEventActionActivation_doAction - unsupported OR in the AcceptEventAction - it can generate nondeterminism. " ++ show aea) else skip --checking unmarshall if (function_ActivityNode_AcceptEventAction_isUnmarshall aea) == True then error( "operatio_AcceptEventActionActivation_doAction - unsupported unmarshall. " ++ show aea) else skip --checking mandatory presence of init in the sterotypes previous and precededBy if (prec && vsInitP2 == FUML_Syntax_Classes_Kernel_ValueSpecificationEmpty) || (prev && vsInitP1 == FUML_Syntax_Classes_Kernel_ValueSpecificationEmpty) then error( "operatio_AcceptEventActionActivation_doAction - Previous or PrecededBy without an initial value. " ++ show aea) else skip -- -- PRECEDEDBY AND PREVIOUS -- FIRST TICK -- if it is mark as precededBy or PREVIOUS -- and it is the first tick if ((prec || prev) && function_fUML_isFirstTick l ev) then let vsInit = if prev then vsInitP1 else vsInitP2 in do -- marking the occurrence of the event rule_fUML_incrementEventClock l ev -- evaluate initial value initobj <- (operatio_Executor_evaluate ex vsInit) -- object token ot <- (rule_FUML_Semantics_Activities_IntermediateActivities_Token_create FUML_Semantics_Activities_IntermediateActivities_ObjectToken) function_ActivityNodeActivation_heldTokens(vl,res) := {ot} function_Token_ObjectToken_value(ot):= initobj -- stdout -- rule_fUML_out $ "operatio_AcceptEventActionActivation_doAction ACCEPT PRE init signal:" ++ show sig ++ show aea else skip -- -- PREVIOUS VALUES -- marked as previous and it is not first tick if prev && not (function_fUML_isFirstTick l ev) then do -- checking size if length pots == 0 then do -- empty token emp <- (rule_FUML_Semantics_Activities_IntermediateActivities_Token_create FUML_Semantics_Activities_IntermediateActivities_ObjectToken) function_ActivityNodeActivation_heldTokens(vl,res) := {emp} -- stdout -- rule_fUML_out $ "operatio_AcceptEventActionActivation_doAction ACCEPT PRE absence signal:" ++ show sig ++ show aea else let firstO = head pots in do -- marking the occurrence of the event rule_fUML_incrementEventClock l ev -- write object token with signals forall o <- pots do do if not ( o `operatio_Value_equals` firstO) then error( "operatio_AcceptEventActionActivation_doAction - Causality problem. Signal defined with different values. " ++ show aea) else do -- object token ot <- (rule_FUML_Semantics_Activities_IntermediateActivities_Token_create FUML_Semantics_Activities_IntermediateActivities_ObjectToken) function_ActivityNodeActivation_heldTokens(vl,res) := {ot} function_Token_ObjectToken_value(ot):= o -- stdout -- rule_fUML_out $ "operatio_AcceptEventActionActivation_doAction ACCEPT PRE signal:" ++ show sig ++ show aea else skip -- -- CURRENT VALUES -- -- not previous, not using precededBy or it is not the first tick if not prev && not (prec && function_fUML_isFirstTick l ev) then -- checking if other can generate the signal excluding the current activityexecution if function_fUML_signal_CAN_beGenerated vl sig then -- marking as waiting rule_fUML_activityExecution_suspend vl FUML_Status_WaitingSignal aea else -- NOBODY can generate the signal... so -- it has a value if length cots > 0 then let firstO = head cots in do -- -- marking the occurrence of the event rule_fUML_incrementEventClock l ev -- write object token with signals forall o <- cots do do if not ( o `operatio_Value_equals` firstO) then error( "operatio_AcceptEventActionActivation_doAction - Causality problem. Signal defined with different values. " ++ show aea) else do -- object token ot <- (rule_FUML_Semantics_Activities_IntermediateActivities_Token_create FUML_Semantics_Activities_IntermediateActivities_ObjectToken) function_ActivityNodeActivation_heldTokens(vl,res) := {ot} function_Token_ObjectToken_value(ot):= o -- stdout --rule_fUML_out $ "operatio_AcceptEventActionActivation_doAction ACCEPT CURRENT signal:" ++ show sig ++ show aea else if not (function_Locus_physicalClkIsOnEdge (function_Value_ExtensionalValue_locus vl)) then -- MARKING THAT THIS SIGNAL DOES NOT ARRIVE IN THIS DISCRETE EVALUATION -- marking that no other node is running rule_fUML_activityExecution_suspend vl FUML_Status_WaitingSignalTempBlocked aea else -- NONBLOCKABLE if nonb then -- -- USES seq to allow evaluation and comparison of the recently created signal do -- create an absent signal o <- (rule_FUML_Semantics_Classes_Kernel_Value_create FUML_Semantics_CommonBehaviors_Communications_SignalInstance) function_Value_SignalInstance_type(o) := absig -- storing signal function_fUML_storeSignalSupport(vl, aea) := o `seq` do -- store signal without sender rule_fUML_addSignalValue (function_ActivityNode_NamedElement_name(aea),FUML_Semantics_Classes_Kernel_ValueEmpty, ct, sig, (function_fUML_storeSignalSupport(vl, aea))) function_fUML_storeSignalSupport(vl, aea) := FUML_Semantics_Classes_Kernel_ValueEmpty -- returning an empty token (ABSENCE) emp <- (rule_FUML_Semantics_Activities_IntermediateActivities_Token_create FUML_Semantics_Activities_IntermediateActivities_ObjectToken) function_ActivityNodeActivation_heldTokens(vl,res) := {emp} -- stdout --rule_fUML_out $ "operatio_AcceptEventActionActivation_doAction ACCEPT ABSENT signal:" ++ show sig ++ show aea else -- MARKING THAT THIS SIGNAL DOES NOT ARRIVE IN THIS REACTION rule_fUML_activityExecution_suspend vl FUML_Status_WaitingSignalBlocked aea else skip else -- stdout rule_fUML_out $ "operatio_AcceptEventActionActivation_doAction - partially evaluated " ++ show (function_fUML_activity vl) ++ show aea else if aeab && acaeab then -- stdout rule_fUML_out $ "operatio_AcceptEventActionActivation_doAction - partially evaluated " ++ show (function_fUML_activity vl) ++ show aea else skip where -- trigger again tr = one $ function_ActivityNode_AcceptEventAction_trigger aea -- context ct = function_Value_Execution_context vl -- stereotypes from node nonb = function_fUML_stereotypedActivityNode NonBlockable aea prev = function_fUML_stereotypedActivityNode Previous aea prec = function_fUML_stereotypedActivityNode PrecededBy aea -- event ev = function_Trigger_event tr -- signal sig = function_Event_SignalEvent_signal ev pursig = card ( function_Classifier_Signal_ownedAttribute sig) == 0 -- -- current values for the signal cs = filter (\(v1,v2,s,i) -> v2 == ct && s == sig && i == rt ) $ expr2list $ dom $ function_fUML_signals co = map (\(v1,v2,s,i) -> function_fUML_signals(v1,v2,s,i)) cs -- removing absent signals cowa = filter (\o -> (function_fUML_oneClassifierType o) /= absig) co -- checking if the signal does not have attributes. only one instance else a union of all emitted signals cots = if pursig then [head cowa] else cowa -- absent signal absig = function_Instance_Classifier_Signal_absentSignal -- -- time rc = function_Locus_reactionClock (function_Value_ExtensionalValue_locus vl) rt = function_fUML_Clock_currentTimeInt rc -- -- PREVIOUS values for the signal -- PRE - previous values for the signal in the previous reaction -- ps = filter (\(v1,v2,s,i) -> v2 == ct && s == sig && i == (rt-1) ) $ expr2list $ dom $ function_fUML_signals po = map (\(v1,v2,s,i) -> function_fUML_signals(v1,v2,s,i)) ps -- removing absent signals powa = filter (\o -> (function_fUML_oneClassifierType o) /= absig) po -- checking if the signal does not have attributes. only one instance else a union of all emitted signals pots = if pursig then [head powa] else powa ------------------------------------------------------------------------------------------------------------------------------------------------------------ -- HELP RULES ------------------------------------------------------------------------------------------------------------------------------------------------------------ -- ACTIONS -- -- ADD/SEND SIGNAL -- add a value to a signal -- throw causality errors -- check two conditions -- 1. there is no mixture of absent signals and signals -- 2. the same process can send multiple times the same signal, different throws causality error rule_fUML_addSignalValue :: (String, FUML_Semantics_Classes_Kernel_Value, FUML_Semantics_Classes_Kernel_Value, FUML_Syntax_Classes_Kernel_Classifier, FUML_Semantics_Classes_Kernel_Value) -> Rule() rule_fUML_addSignalValue (nn,ct,obj,sig,o) = -- -- 1. avoid mixture -- it has an absent value and it is trying to put a value -- it has values and it is trying to put an absent value if (hasab && not oabs) || (hasnab && oabs) then error("rule_fUML_addSignalValue - Causality problem. It is not allowed to redefine the signal " ++ show sig ++ " by the action " ++ nn ++ " for the rec class " ++ show (function_fUML_oneClassifierType obj)) else -- 2. avoid different values if (hascs && not (cos `operatio_Value_equals` o)) then error("rule_fUML_addSignalValue - Causality problem. Different value for an existent signal " ++ show sig ++" by the action " ++ nn) else do function_fUML_signals(ct, obj, sig, rt) := o rule_fUML_broadcastSignal (nn,ct,obj,sig,o) where -- object is absent signal absig = function_Instance_Classifier_Signal_absentSignal oabs = function_fUML_oneClassifierType o == absig -- -- all signals for the receiver with the same type as = filter (\(v1,v2,s,i) -> v2 == obj && s == sig && i == rt ) $ expr2list $ dom $ function_fUML_signals -- has absent signal for the receiver and same type -- checking if it has an instance of absentsignal abss = filter (\v1v2si -> (function_fUML_oneClassifierType (function_fUML_signals v1v2si)) == absig) as hasab = length abss > 0 -- checking if it has an instance of not absentsignal hasnab = length abss /= length as -- -- current value for the signal cs = filter (\(v1,v2,s,i) -> v1 == ct && v2 == obj && s == sig && i == rt ) $ expr2list $ dom $ function_fUML_signals hascs = length cs > 0 cos = function_fUML_signals $ head cs -- time l = if (function_Value_ExtensionalValue_locus ct) == FUML_Semantics_Loci_LociL1_LocusEmpty then (function_Value_ExtensionalValue_locus obj) else (function_Value_ExtensionalValue_locus ct) rc = function_Locus_reactionClock l rt = function_fUML_Clock_currentTimeInt rc -- defines (if applicable) and increments the TimeBase for a given clock rule_fUML_incrementEventClock :: FUML_Semantics_Loci_LociL1_Locus -> FUML_Syntax_CommonBehaviors_Communications_Event -> Rule() rule_fUML_incrementEventClock l ev = -- event clock let evc = function_fUML_retrieveClock l ev in if evc /= FUML_Semantics_Extensions_Clock_ClockEmpty then let eventTimeBase = function_Clock_timeBase evc in -- clock exists -- if it has only one element add a new instant (each reaction has only two instants the previous (if exists) and the current if length (function_TimeBase_instants eventTimeBase) == 1 then do -- incrementing ri <- (rule_FUML_Semantics_Extensions_Clock_Instant_create FUML_Semantics_Extensions_Clock_JunctionInstant) function_Instant_date(ri) := (function_Clock_currentTime evc) + 1.0 function_Instant_tb(ri):=eventTimeBase -- it does not move current else skip else -- clock does not exist let mtb = function_Locus_mainTimeBase l in do eventClk <- (rule_FUML_Semantics_Extensions_Clock_Clock_create FUML_Semantics_Extensions_Clock_LogicalClock) eventTimeBase <- (rule_FUML_Semantics_Extensions_Clock_TimeBase_create FUML_Semantics_Extensions_Clock_DiscreteTimeBase) -- creating eventClock function_Clock_LogicalClock_definingEvent(eventClk) := ev function_Clock_resolution(eventClk) := 1.0 function_Clock_timeBase(eventClk) := eventTimeBase function_Clock_LogicalClock_locus(eventClk) := l -- a new timebase in the multipletimebase function_TimeBase_owningMTB(eventTimeBase):= mtb -- instant ri <- (rule_FUML_Semantics_Extensions_Clock_Instant_create FUML_Semantics_Extensions_Clock_JunctionInstant) -- initial tick is 1 function_Instant_date(ri) := 1.0 function_Instant_tb(ri):=eventTimeBase -- it does not move current function_TimeBase_currentInstant(eventTimeBase) := FUML_Semantics_Extensions_Clock_InstantEmpty -- -- it assumes only one object in the receiver position for each port (not an array) -- it assumes that the model is compliant with the static semantics rule_fUML_broadcastSignal :: (String, FUML_Semantics_Classes_Kernel_Value, FUML_Semantics_Classes_Kernel_Value, FUML_Syntax_Classes_Kernel_Classifier, FUML_Semantics_Classes_Kernel_Value) -> Rule() rule_fUML_broadcastSignal (nn,ct,obj,sig,o) = -- check if -- parent from the receiver is defined, -- receiver is not running the classifierbehavior (otherwise it should define the behavior, and it should not be applied the default semantics of broadcast) if parentWithConnector /= FUML_Semantics_Classes_Kernel_ValueEmpty && not (function_fUML_classifierBehaviorIsRunning obj) then do -- for each connector retrieved based on connectors for the parent of the sender forall con <- cons do -- retrieve ports let endSender = if (readRole parentrec (fConnectorEnd con)) == obj then (fConnectorEnd con) else (lConnectorEnd con) let endReceiver = if (readRole parentrec (fConnectorEnd con)) /= obj then (fConnectorEnd con) else (lConnectorEnd con) let portSender = function_ConnectorEnd_role endSender let portReceiver = function_ConnectorEnd_role endReceiver let conKind = function_Feature_Connector_kind con let partReceiver = readPart parentWithConnector endReceiver let roleReceiver = readRole parentWithConnector endReceiver -- port behavior retrieve the part, otherwise retrieve the port -- otherwise use the role let newReceiver = if function_Feature_type portReceiver == FUML_Syntax_Extensions_CompositeStructures_Port && function_Feature_Port_isBehavior portReceiver then partReceiver else roleReceiver -- check if -- 1. new sender is a port not Behavioral -- 2. sender is conjugated -- assembly and delegation use the same rule if not (function_Feature_Port_isBehavior portSender) && function_Feature_Port_isConjugated portSender then -- check if -- 1. receiver exists -- 2. receiver is different from the sender if newReceiver /= FUML_Semantics_Classes_Kernel_ValueEmpty && newReceiver /= ct then do -- sending rule_fUML_addSignalValue (nn, obj, newReceiver,sig,o) -- stdout --rule_fUML_out $ "rule_fUML_broadcastSignal - brodcasting signal CONJUGATED " ++ show sig ++ " from " ++ show (function_fUML_oneClassifierType obj) ++ " to " ++ show (function_fUML_oneClassifierType newReceiver) else skip else skip -- check if -- 1. new sender is a port not Behavioral -- 2. it is a delegation connector and sender is not conjugated if not (function_Feature_Port_isBehavior portSender) && not (function_Feature_Port_isConjugated portSender) && function_Feature_Connector_kind con == FUML_Syntax_Extensions_CompositeStructures_ConnectorKind_delegation then -- check if -- 1. receiver exists -- 2. receiver is different from the sender if newReceiver /= FUML_Semantics_Classes_Kernel_ValueEmpty && newReceiver /= ct then do -- sending rule_fUML_addSignalValue (nn, obj, newReceiver,sig,o) -- stdout --rule_fUML_out $ "rule_fUML_broadcastSignal - brodcasting signal NOT CONJUGATED " ++ show sig ++ show con ++ show parentWithConnector else skip else skip else if not (function_fUML_classifierBehaviorIsRunning obj) && (length parentrecl > 1 || length paparentrecl > 1 ) then -- stdout rule_fUML_out $ "rule_fUML_broadcastSignal - Signal "++show sig++" not broadcasted because more than one candidate parent were located " ++ show (length parentrecl) ++ show (length paparentrecl) else skip where -- -- retrieving parent active object for receiver -- it must have the receiver object as property, and it has connectors pasobjs = [(a,o,f) | a <- (expr2list function_fUML_activeObjects), (o,f) <- expr2list (function_fUML_getAllPassiveObjectChildsWithFeature a) ++ expr2list (function_fUML_getActiveObjectChildsWithFeature a)] parentrecl = filter (\(a,o,f) -> o == obj && function_Feature_type f == FUML_Syntax_Extensions_CompositeStructures_Port) pasobjs parentrec = if length parentrecl == 1 then head (map (\(a,o,f) -> a) parentrecl) else FUML_Semantics_Classes_Kernel_ValueEmpty parclr = function_fUML_oneClassifierType (parentrec) cosr = if parclr /= FUML_Syntax_Classes_Kernel_ClassifierEmpty then function_Classifier_StructuredClassifier_ownedConnector parclr else {} -- parent of parent with connectors paparentrecl = filter (\(a,o,f) -> o == parentrec && card (function_Classifier_StructuredClassifier_ownedConnector( function_fUML_oneClassifierType (a))) > 0 && one (function_Classifier_StructuredClassifier_ownedConnector( function_fUML_oneClassifierType (a))) /= FUML_Syntax_Classes_Kernel_FeatureEmpty) pasobjs paparentrec = if length paparentrecl == 1 then head (map (\(a,o,f) -> a) paparentrecl) else FUML_Semantics_Classes_Kernel_ValueEmpty paparclr = function_fUML_oneClassifierType (paparentrec) pacosr = if paparclr /= FUML_Syntax_Classes_Kernel_ClassifierEmpty then function_Classifier_StructuredClassifier_ownedConnector paparclr else {} -- parentWithConnector = if length (mcos cosr parentrec obj) > 0 then parentrec else if length (mcos pacosr paparentrec parentrec) > 0 then paparentrec else FUML_Semantics_Classes_Kernel_ValueEmpty cons = if length (mcos cosr parentrec obj) > 0 then (mcos cosr parentrec obj) else if length (mcos pacosr paparentrec parentrec) > 0 then (mcos pacosr paparentrec parentrec) else [] -- -- abbreviations -- -- connector must -- have two ends, -- roles must be ports only with reception -- one of the ends should be the object (sender or receiver depending on the parameter) mcos p oc poc = filter (\c -> c /= FUML_Syntax_Classes_Kernel_FeatureEmpty && card (function_Feature_Connector_end c) == 2 && (( function_Feature_type (function_ConnectorEnd_role (fConnectorEnd c)) == FUML_Syntax_Extensions_CompositeStructures_Port && ((readPart oc (fConnectorEnd c)) == poc || (readRole oc (fConnectorEnd c)) == poc) ) || ( function_Feature_type (function_ConnectorEnd_role (lConnectorEnd c)) == FUML_Syntax_Extensions_CompositeStructures_Port && ((readPart oc (lConnectorEnd c)) == poc || (readRole oc (lConnectorEnd c)) == poc) ) ) ) $ expr2list p fConnectorEnd c = head $ expr2list (function_Feature_Connector_end c) lConnectorEnd c = last $ expr2list (function_Feature_Connector_end c) readPart o ce = if function_ConnectorEnd_partWithPort ce /= FUML_Syntax_Classes_Kernel_FeatureEmpty then function_Value_Reference_referent (function_fUML_readStructuralFeature o (function_ConnectorEnd_partWithPort ce)) else FUML_Semantics_Classes_Kernel_ValueEmpty readRole o ce = function_Value_Reference_referent (function_fUML_readStructuralFeature o (function_ConnectorEnd_role ce)) ------------------------------------------------------------------------------------------------------------------------------------------------------------ -- ACTIVITIES -- -- ACTIVITY EXECUTION - SUSPEND RULE rule_fUML_activityExecution_suspend :: FUML_Semantics_Classes_Kernel_Value -> FUML_Status -> FUML_Syntax_Activities_IntermediateActivities_ActivityNode -> Rule () rule_fUML_activityExecution_suspend v s n = if function_Value_type(v) == FUML_Semantics_Activities_IntermediateActivities_ActivityExecution && function_fUML_Agents_mode(v) == FUML_Status_Running then do function_fUML_Agents_mode(v) := s -- marking that no other node is running forall on <- otherN do function_ActivityNodeActivation_isRunning(v,on) := False else skip where an = function_Activity_node act act = function_fUML_oneClassifierType v otherN = expr2list (an `difference` {n}) -- -- ACTIVITY EXECUTION - RESUME RULE rule_fUML_activityExecution_resume :: FUML_Semantics_Classes_Kernel_Value -> Rule () rule_fUML_activityExecution_resume v = if function_Value_type(v) == FUML_Semantics_Activities_IntermediateActivities_ActivityExecution && function_fUML_Agents_mode(v) /= FUML_Status_Running then do -- should reexecute the the activity and node (next iteration), mark activity as running, node as not running and put a control token in it function_fUML_Agents_mode(v) := FUML_Status_Running -- if is an action it should be rerun if function_fUML_isAction(nr) then do function_ActivityNodeActivation_isRunning(v,nr) := False -- add a token when it was started by control tokens (incoming > 0) -- and it is an action if function_fUML_noIncomingEdge nr then skip else do nct <- (rule_FUML_Semantics_Activities_IntermediateActivities_Token_create FUML_Semantics_Activities_IntermediateActivities_ControlToken) function_ActivityNodeActivation_heldTokens(v,nr) := {nct} else -- control flow not skip --`seq` -- stdout --rule_fUML_out $ "rule_fUML_resumeActivity RUNNING Activity: " ++ show cl ++ " Agents: " ++ show (function_fUML_Agents_mode v) ++ " fireable: " ++ show (function_fUML_shouldFire v) ++ " heldtokens:" ++ show (filter (\(vn,nr)-> vn==v) (expr2list $ dom $ function_ActivityNodeActivation_heldTokens)) else skip where -- cl = function_fUML_oneClassifierType (v) -- supports reevaluation tokens = filter (\(vi,n) -> vi == v) $ expr2list $ dom function_ActivityNodeActivation_heldTokens (vi,nr) = head $ filter (\(vi,n) -> vi == v) $ expr2list $ dom function_ActivityNodeActivation_isRunning ------------------------------------------------------------------------------------------------------------------------------------------------------------ -- HELP FUNCTIONS -- -- CAUSALITY -- SIGNALS -- checks if a determined signal can be generated by other runnable agents -- TODO MEDIUM PRIORITY - CONSIDER : CallBehavior and StartObjectBehavior (CAUTION) -- position of the current control flow and the sendsignalaction -- Signal Type function_fUML_signal_CAN_beGenerated :: FUML_Semantics_Classes_Kernel_Value -> FUML_Syntax_Classes_Kernel_Classifier -> Bool function_fUML_signal_CAN_beGenerated vl sig = canBe where ags = expr2list $ function_fUML_Agents_runnableInThisDiscreteEvaluation `difference` {vl} acs = concat $ map (\v -> expr2list $ function_Value_Object_types(v)) ags acsds = filter (\ac -> length ( filter (\n -> function_ActivityNode_type(n) == FUML_Syntax_Actions_BasicActions_SendSignalAction && (function_ActivityNode_SendSignalAction_signal n) == sig ) $ expr2list $ function_Activity_node ac ) > 0 ) acs canBe = length acsds > 0 -- -- ACTIVENESS - CLASSIFIERBEHAVIOR -- check if it is an instance of active class, classifierbehavior is running and it has discrete domain function_fUML_classifierBehaviorIsRunning :: FUML_Semantics_Classes_Kernel_Value -> Bool function_fUML_classifierBehaviorIsRunning o | function_Value_type(o) == FUML_Semantics_Classes_Kernel_Object = function_fUML_classifierBehaviorExecution o /= FUML_Semantics_Classes_Kernel_ValueEmpty | otherwise = error( "function_fUML_classifierBehaviorIsRunning - unsupported valuetype " ++ show o) function_fUML_classifierBehaviorExecution :: FUML_Semantics_Classes_Kernel_Value -> FUML_Semantics_Classes_Kernel_Value function_fUML_classifierBehaviorExecution o | function_Value_type(o) == FUML_Semantics_Classes_Kernel_Object = if length exrclb /= 0 then head exrclb else FUML_Semantics_Classes_Kernel_ValueEmpty | otherwise = error( "function_fUML_classifierBehaviorExecution - unsupported valuetype " ++ show o) where vs = function_Locus_extensionalValues( (function_Value_ExtensionalValue_locus o) ) -- classifier behavior cl = function_fUML_oneClassifierType o clb = function_Classifier_BehavioredClassifier_classifierBehavior cl -- all values in locus with the context object vse = filter (\v -> function_Value_Execution_context(v) == o && function_Value_type(v) == FUML_Semantics_Activities_IntermediateActivities_ActivityExecution) (expr2list $ vs) -- all values running exr = filter (\v -> (inDom v function_fUML_Agents_mode)) vse -- execution for classifierbehavior exrclb = filter (\v -> ((function_Value_Object_types(v) `intersect` {clb}) /= {})) exr -- -- CLOCK AWARE -- -- retrieves a clock given an event function_fUML_retrieveClock :: FUML_Semantics_Loci_LociL1_Locus -> FUML_Syntax_CommonBehaviors_Communications_Event -> FUML_Semantics_Extensions_Clock_Clock function_fUML_retrieveClock l ev = let cls = filter (\c -> function_Clock_LogicalClock_definingEvent(c) == ev) $ expr2list (function_Locus_logicalClocks l) in if length cls == 1 then head cls else FUML_Semantics_Extensions_Clock_ClockEmpty -- -- check if it is the first tick for a given agent -- either clock odes not exist or it exist without currentTimeInstant (what is returned by currentTimeInt as 0) function_fUML_isFirstTick :: FUML_Semantics_Loci_LociL1_Locus -> FUML_Syntax_CommonBehaviors_Communications_Event -> Bool function_fUML_isFirstTick l ev = let cl = function_fUML_retrieveClock l ev in if cl == FUML_Semantics_Extensions_Clock_ClockEmpty || function_fUML_Clock_currentTimeInt cl == 0 then True else False -- -- BROADCAST -- -- -- get all active objects function_fUML_activeObjects :: {FUML_Semantics_Classes_Kernel_Value} function_fUML_activeObjects = ddao where vs = dom function_Value_ExtensionalValue_locus ddao = mkSet $ filter (\v -> function_Value_type(v) == FUML_Semantics_Classes_Kernel_Object && function_fUML_classifierBehaviorIsRunning(v)) (expr2list $ vs) -- get all childs for a given object returning object and feature -- it is not recursive, only features directed child -- it does not retrieve passive objects as childs function_fUML_getActiveObjectChildsWithFeature :: FUML_Semantics_Classes_Kernel_Value -> {(FUML_Semantics_Classes_Kernel_Value,FUML_Syntax_Classes_Kernel_Feature)} function_fUML_getActiveObjectChildsWithFeature o | function_Value_type(o) == FUML_Semantics_Classes_Kernel_Object = (mkSet vllo) | otherwise = error( "function_fUML_getActiveObjectChildsWithFeature - unsupported valuetype " ++ show (function_Value_type o)) where -- featurevalue -- filter feature with values vlv = filter (\cov -> length(function_FeatureValue_values cov) > 0) (expr2list $ function_Value_CompoundValue_featureValues o) -- gets first value to check type vll = map (\cov -> (head $ function_FeatureValue_values(cov),cov)) vlv -- references vllr = filter (\(vl,_) -> (function_Value_type vl) == FUML_Semantics_Classes_Kernel_Reference && function_Classifier_Class_isActive(function_fUML_oneClassifierType (function_Value_Reference_referent vl))) vll -- objects vllo = map (\(ref,f) -> (function_Value_Reference_referent ref, (function_FeatureValue_feature f))) vllr -- get all childs for a given object returning object and feature -- it is not recursive, only features directed child -- it does not retrieve active objects as childs function_fUML_getAllPassiveObjectChildsWithFeature :: FUML_Semantics_Classes_Kernel_Value -> {(FUML_Semantics_Classes_Kernel_Value,FUML_Syntax_Classes_Kernel_Feature)} function_fUML_getAllPassiveObjectChildsWithFeature o | function_Value_type(o) == FUML_Semantics_Classes_Kernel_Object = (mkSet vllo) | otherwise = error( "function_fUML_getAllObjectChildsWithFeature - unsupported valuetype " ++ show (function_Value_type o)) where -- featurevalue -- filter feature with values vlv = filter (\cov -> length(function_FeatureValue_values cov) > 0) (expr2list $ function_Value_CompoundValue_featureValues o) -- gets first value to check type vll = map (\cov -> (head $ function_FeatureValue_values(cov),cov)) vlv -- references vllr = filter (\(vl,_) -> (function_Value_type vl) == FUML_Semantics_Classes_Kernel_Reference && not (function_Classifier_Class_isActive(function_fUML_oneClassifierType (function_Value_Reference_referent vl)))) vll -- objects vllo = map (\(ref,f) -> (function_Value_Reference_referent ref, (function_FeatureValue_feature f))) vllr